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/* EDIT: HE2004 
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*f 

#* COPYRIGHT (c) 1978, 1980, 1982, 1984 BY 

#* DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS. 
st ALL RIGHTS RESERVED. 

#e THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COP 
#* ONLY IN ACCORDAN H E 


® 

*® 

® 

© 

w 

. 

® 

® 

Y Ov R : 
#* OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY * 
#* TRANSFERRED. . 
® 

ts THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE  * 
® 

® 

® 

*® 

® 

® 

® 

® 


N 
OULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT 
** CORPORATION. 


** DIGITAL ASSUMES NO RESPONSIB 


IBILITY FOR THE USE OR RELIABILITY OF ITS 
** SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. 
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facility: VAX=11 PL/I Runtime Library. 
abstract: This routine is called to process the environment attributes 
for the PL/I open service. 
author: C. Spitz 
Modifications: 
V¥1.4-02: Bill Matthews 28-Sep-1981 


Fix to not maximize versions ever when an explicit version 
number is specified. 


V1.4-03: Bill Matthews 08-Oct-1981 


Fix coding of protection meek rey to not rely on short circuit 
boolean optimization for correc 


V2.0-04: Hisham Elbasha 11-NOV-1982 


make the upi bit independent of the bio bit for shared_read 
and shared_write. 


SOONG 


execution of the program. 


«/ 


/t 

Local vemsenterys 
The environment options for a file ney be specified on the DECLARE 
statement for the file, on the pe Statement, or on the CLOSE 
Statement. The environment options are represented as a list of 
elements, where each element is represented by its type code, and 
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56 } its value. The type code is one byte long; valid gape have 
57 values of 1 through num_envir_opts. The value of s used to des- 
58 } ignate the end of the environment ist. Each environment option has 
59 | a@ parameter, whose interpretation is dependant upon the option. The 
60 | parameters data types are: 
61 | immediate bit - represented as 1 byte. low bit = value 
62 | immediate value - represented as 1 longword 
65 | immediate character - represented as n bytes. the first 
64 | bytes are the total length of the character 
65 | string, the second 2 bytes are the current length 
66 | of the character sting, and the remaining n-4 bytes 
67 | are storage for the total length of the string. Note 
68 | that both Lengths do not include the Length fields. 
69 } address - represented as a 4 byte absolute address. 
£9 H quad value - represented as a 4 byte absolute address. */ 
7 pli$Senvir: preen teres Seae* Pers ante mes options (ident('1-004')) 
ie, returns(fixed bin(31)); 
75 3 /* parameter declarations */ 
76 del fcbpt pointer, /* pointer to file control block */ 
77 openv pointer, /* pointer to open environment = */ 
78 open_blk pointer; /* pointer to open block «/ 


oo 
oO 


/* the following is a template for the macro open block */ 
dc 1 opn based(open_blk), 


1 
1 
1 
1 
1 
1 
! 
8 1 § status(0:31) . 
8 1 create_date(0:1) fixed bin(31), 
84 1 2 expire_date(0:1) fixed bin(31), 
85 1 2 file_id_to_pt pointer, 
86 1 2 fixed_control_to_pt pointer, 
87 1 2 prot(0:15) : 
88 1 2 own_group fixed bin(15), 
89 1 own_mem fixed bin(15); 
90: 1 /* bit offsets for status */ 
91 1 Zreplace create_dat y 0; 
9 1 Zreplace expire_dat by 1; 
9 1 Zreplace fileid to by ¢: 
94 1 Zreplace fixedcftl_to by 3; 
95 1 Zreplace protect by 4; 
96 1 Zreplace uic by 5; 
97 1 Zreplace close by 6; 
98: 1 /* bit offsets for protection */ 
99 1 Zreplace no_read by 0; 
1001 Zreplace no_write by 1; 
101 1 Zreplace no execute by 2; 
106 1 Zreplace no_delete by 3; 
10 1 Zreplace syStem_prot by 0; 
104 1 Zreplace owner_prot by 4; 
105 1 Zreplace group_prot by 8; 
106 : Zreplace world_prot by 12; 
108 ; 1 /* general constants */ 
109 1 Zreplace true by ‘1b; 
19 ' Zreplace false by ‘'0'b; 
112 1 


/* global declarations */ 


D 15 
PLISSENVIR 16-SEP-1984 229: VAX=-11 PL/I 
1 2. gEb- 138% 96:69:33 ISKSVMSMASTER:¢ 
11 1 Zinclude envcodes; /* define environment codes and types */ 
4 : Zinclude filedef; /* define file control block, fab, rab, nam*/ 
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409 : 1 . local dats = static */ 

410: 1 * the eb table contains the parameter type for each environment option*/ 
4) 1 Srestsce bit by 0; 

41 , Zreplace longtyp by 1; 

4) Zreplace ole by ¢! 

414 1 Zreplace stringtyp by 3; 

415 1 Zreplace addrtyp by 4; 

416 1 dcl env_type(num_envir_opts) fixed bin(7) static readonly | 
417 1 init™ bittyp, * append */ 

418 1 bittyp, /* batch */ 

419 1 bittyp, /* prock R-Roungry «/ 

420 1 bittyp, /* b 

421 1 lLongtyp. /* dette size */ 

4 ¢ 1 Longtyp,. /* bucket_size */ 

4 1 bittyp, /* carriage */ 

424 1 bittyp, /* contiguous */ 

425 1 bittyp, /* contiguous_best_try */ 
426 1 quadtyp, /* creation_date *7 

427 1 bittyp, /* current_position */ 
428 1 stringtyp,. /* default_file_name */ 
429 1 bittyp, /* defered_write */ 

430 1 bittyp,. /* delete */ 

431 1 quadtyp, /* expiration. date */ 
432 1 longtyp, /* extension_Size */ 

433 1 addrtyp,. /* file_id *7 

434 1 addrtyp, /* tiles ig to */ 

435 1 lLongtyp, /* file-size */ 

436 1 Longtyp, /* fixed_control_size */ 
437 1 addrtyp, /* fixed-control_size_to */ 
438 1 bittyp. /* fixed_length_fecords */ 
439 1 stringtyp, /* group. “protection */ 
440 1 bittyp,. /* ignore_Line_marks */ 
44) 1 bittyp, /* indexed */ ~ 

44 1 bittyp, /* indexed_fill */ 

44 1 longtyp. /* index_nimber */ 

444 1 longtyp, /* max_récord_number */ 
445 1 Longtyp, /* max_record_size */ 
446 1 Longtyp, /* mul€iblock_count */ 
447 1 lLongtyp,. /* aultibutfeF count */ 
448 1 bittyp, /* no_share */~ 

449 1 longtyp,. /* owner_group */ 

450 1 longtyp, /* owner_member */ 

451 1 stringtyp. /* owner_protection */ 
£26 1 bittyp, /* printér */ 

45 1 bittyp,. r* read_ahead */ 

454 4 bittyp,. /* read_check */ 

455 1 bittyp, /* record. id_access */ 
456 1 longtyp. /* retrett ea tes sbointers af 
457 1 bittyp, /* rewi ose */ 

458 1 bittyp. /* hd to open *./ 

459 1 bittyp, /t sealarverying «/ 

460 1 bittyp,. /* shared_r reve * 

461 1 bittyp,. /* shared_write / 

466 1 bittyp, /* spool #/ 

46 1 bittyp, /* supersede */ 

464 1 stringtyp. /* system_protection */ 


st te tb te ts 
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/* temporary */ 
/* truncate */ 
/* world_protection */ 
/* write_behind */ 
/* write_check */ 


static readonly /* end of environment list */ 
fixed bin(7) 


char(4) static readonly init('.DAT'); 


it (unused _envir_opt); 


1 
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476: 1 /* local data = automatic */ 

47 1 del fc pointer, /* local pointer to fcb (unaliased) */ 

478 1 declared_environment pointer 

479 1 current_env_number tixed bin(7) 

480 1 next_specifted_env_number fixed bin(?), 

481 1 Longtemp fixed bin(31), 

48 1 point pointer, /* utility pointer */ 

48 1 error_code fixed (31), 

tee : : carriage_specified_false bit aligned, /* wee was specified 
: s 

486 1 specified bit aligned; /* true if current_env_number was 

re : ! specified in an environment List */ 

489: 1 /* the tg ag are used to compare the declared and open environments, to 

490: 1 ensure that hey are the same. THEY ARE NOT AVAILABLE FOR USE AS TEMPS. */ 

491 1 dcl bitval(0:1 bit aligned, 

49 1 addrval (0:1) pointer 

49 1 Longval (0:1) fixed bin(31), 

494 1 quadval(0:1,0:1) fixed bin(31); 

495: 1 /* 

496: 1 
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497; 1 /* based declarations */ 1 
498 : 1 /* the following declarations are templates for the various types of environment 1 
499: 1 options. there is one template for each parameter type. */ 1 
500 1 del 1 optbit based, 1 
501 1 env number fixed bin(7), 1 
: 206 1 bit bit, 1 
50 1 bitext(7) bit, . 
abe 1 bitnext fixed bin(7); 1 
05 1 del 1 optlon based, 1 
206 1 env_number fixed bin(7) 1 
20 1 Long fixed bin(315, 1 
08 1 Longnext fixed bin(7); 1 
509 1 del 1 optaddr based, 1 
510 1 env_number fixed bin(7), 1 
511 1 address pointer 1 
s1¢ addrnext fixed bin(7); 1 
51 1 del 1 optstring ased, 1 
514 1 env_number fixed bin(7) 1 
5151 maxSize fixed binc5s, 1 
516 1 string char(128) var; 1 
517 1 del 1 optstringnext based, 1 
518 1 env_number fixed bin(7) 1 
519 1 maxsize fixed bin(155, 7 
520 § cursize fixed bin(15), 1 
: 1 ; stringnext(0:128) fixed bin(7); } 
5 5 ; 4 /* the following are templates for moving values around */ 1 
524 del value fixed bincst) based: 1 
525 1 del qvalue(0:1) fixed bin(31) based; 1 
526 1 del byte fixed bin(7) based(addr(longval)); 1 
507, 1 del word fixed bin(15) based(addr(longval)); 1 
528 1 dcl fileid char(22) based(addrval(0)); 1 
26) 1 del bytetemp ; fixed bin(7) based(addr(longtemp)) ; 1 
5 1 del wordtemp fixed bin(15) based(addr(longtemp)); 1" 
531 1 del buflen fixed bin(15) based( 1 
532 1 addr(fcb=->file_constant.buffer_end)); 1 
3: a del stringtemp char(128) var based; 1 
534 1 del 1s based, 1 
535 1 2 stringlen fixed bin(15), 1 
536 1 2 stringval char (128); 1 
537 1 1 
1 

1 
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238 i 4 /* declarations s of error messages and error 9 u tines «/ 
9 1 dcl pliS$io_error qntry (i ixeg 0 fat 1) vejue. 
40 1 d bin(31) value,pointer value); 
29 del pli$_undfile globalref fixed bin(31) value; 
ri} 1 dcl pli$_envparm globalref tired bin(31) value; 
4 1 dcl pli$_invdfnam Qlobalref fixed bin(31) value; 
44 1 dcl pli$_c conspesyp globalref fixed bin(31) value; 
45 1 del pli$_conblokio Qlobalref fixed bin(31) value; 
re 1 dcl pli$_invrtvptr Qlobalref fixed bin(31) value; 
4 1 dcl pli$_noshare Qlobalref fixed bin(31) value; 
48 1 dcl pli$_invprot globalref fixed bin(31) value; 
49 1 del pli$_invmltblk Qlobalref fixed bin(31) value; 
50 1 dcl pli$_invml tbuf globatref fixed bin(31) value; 
22) 1 dcl pli$_ fony talon globalref fixed bin(31) value; 
26 1 del pli$_invindnum globalref fixed bin(31) value; 
55 1 dcl pli$_invblksiz Qlobalref fixed bin(31) value; 
54 1 dcl pli$_invbktsiz globalref fixed bin(31) value; 
55 1 dcl pli$_invextsiz globalref fixed bin(31) value; 
55 1 del pli$_invfxcsiz gQlobalref fixed bin(31) value; 
557 1 dcl pli$_conenvopt gQlobalref fixed pints} value; 
558 1 dcl pli$_conprintcr globalref fixed bin(31) value; 
559 1 dcl pli$_invowngrp globalref fixed bin(31) value; 
560 1 dcl pLi$_invownmem globalref fixed bin(31) value; 
561 *1 del pli$_conprttrm globalref fixed bin(31) value; 
206 1 del pli$_creindex gQlobalref fixed bin(31) value; ' 
$07 : dcl pli$_invmaxrec globalref fixed bin(31) value; 


1 
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/* initialization */ 
/* define general error condition handler */ 
on anycondition begin; 

error_code = pli$_envparm; 

goto opt_error; 

end; 


fcb = fcbpt; /* copy fcb pointer to local storage */ 


o 
uw 


SSE 
ed a IN 


7 declared_environment = addr(fcb => fcb_end); /* point to declared environment */ 
74 f openv = null 

75 then openv = addr(end_opt); 

7 if tcb -> fcb_end = 0 | opn.s€atus(close) 

7 then declared_environment = addr(end_opt); 
af8 next_specified_env_number = 0; 
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84 


/* main loop */ 
do current_env_number = 0 to num_envir_opts; 
specified = (next_speci ffed_env_nun er = current_env_number) ; 
if meee yt nee 
en do; 


5 if current_env_number = batch : 
current_env_number = delete | 
current_env number = rewind close } 
current_env_number = spool | 


current_env_number = truncate 
then goto opt(current_env_number) ; 


end; 
else goto opt(current_env_number) ; 
goto next_opt; 


/* error routine */ 


opt_error: 
revert gayconditten: 
call pli$ o_error(pli$_undfile,error_code,fcb); 


return(pli$_undfile); 
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1 
603 opt(0): 1 
60 goto next_opt; 1 
604 opt (append) : 1 
983 if specified ¢ Speman 1 
£09 => attr(atriv ap ) = true; 
608 fcb => fab$l_fop(TabSv_mxv) = false; C 
609 fcb -> fab$Sl"fop(fab$v_cif) = true; a 
610 fcb => fab$l-fop(fab$v_sup) = false; 
611 fcb => fabst~ =fop( fabsv_ net) = false; PL 
oi¢ a -> rab$l-rop(rab$v_eof) = true; 
614 else fcb => attr(atr_v_app) = false; 
615 goto next_opt; 
616 
617 
618 opt (batch): 
619 fob => fab$l fop(fab$v_scf) = specified & bitval(0); 
620 goto next_opt; 
6 1 
858 $ opt (block_boundry): 
624 § ftb -> fab$b rat(fab$v_blk) = specified & bitval(0); 
625 goto next_opt; 
626 
627 
628 opt (block_io): 
° 9 if specified & bitval(0) i feb -> attr(atr_v_blockio) 
631 "if feb => fab$b_ ray (fabs otk) 
O36 fcb -> © .tr(atr_v_stream) 
63 then do; 
634 4 error_code = plis_ conblokio; 
oe? 2 goto opt_error; 
637 ; fcb -> fab$b_ facttabsv bio) = true; 
O38 feb -> fabSb_rfm = fab$c_ud 
end; 
640 else fcb -> fab$Sb_fac(fab$v_bio) = Poe 
641 fcb => fabsb shr(fab$v_upi) = false; 
os¢ goto next_opt; 
64 
644 
645 opt (block_size): 
646 if specified 
647 then do; 
oe if mongers SS 0 | longval(0) > 65535 
650 4 error_code = pli$_invblksiz; 
651 4 goto opt_error; 
636 4 en 
65 fcb -> fab$Sw_bls = word: 
654 end; 
$23 : else fed. -> fab$Sw_bls = 0; 
goto next_opt; 
$39 
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opt (bucket_size): 
if“specified 
then do; 
if longval(0) < 0! longval(0) > 32 
then do; 


"error code = plis_ invbktsiz; 
goto opt_error; 


fcb => fab$b_ bks © “ivee: 


end; 
else feb- => fabSb_bks = 0; 
goto next_opt; 


opt (carriage): 
if specified & bitval(0) 
then do; 


if fcb -> attr(atr_v_print) 
then do; 
error_code = plis_ conprintcr; 
goto opt_ error; 


if fcb -> fab$b_ foci tabsv _bio) 
then do; 
error_code = pli$_conblokio; 
— opt. error; 


fcb -> fab$b_ sent iaite _er) = true; 
end; 

else do; 
fcb -> fab$Sb_rat(fab$v_cr) = false; 
carriage. specified_falSe = specified; 


feb => fab$b rat(fabSv. ftn) = false; 
goto next_opt; 


opt (contiguous) : ? 
fcb => fabSl fop( fab$v_ ctg) = specified & bitval(0); 
goto next_opt; 


opt (contiguous. best_try 
fcb =>" fab$T fopitabsv. cbt) = specified & bitval(0); 
goto a. opt; 


ape Sneeny es date): 


Becified 
then do; 
create_date(0) = quadval(0,0); 
create_date(1) = quadval(0,1); 
opn.status(create_dat) = true; 


end: 
goto next_opt; 
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eS a fop( fab$v_ pos) = specified & bitval(0); 
goto next_opt; 


opt (default_ Mee, name): 
if Specified 
then do; 
if wey stringlen > 128 
0; 


error_code = plis_ invdfnam; 
goto opt_error; 


en 
fob -> fab$l_dna = addr(addrval(0) => stringval); 
Lon ongtemp = addrval(0) => stringlen; 
fcb => fab$b_dns = y AEs 
eng; 

else do; 

fcb => fab$l_dna 
fcb => fab$b_dns 


= addr(default_name); 

4 = length(default_name); 
end; 

goto next_opt; 


opt (defered_write) ; 
fcb' => fabSl fop(fab$v_dfw) = specified & bitval(0); 
goto next_opf; 


opt (delete): 
fcb => fab$l_fop(fab$v_dlt) = specified & bitval(0); 
goto next_opt; 


epehantas Gaye): 
if specified 
then do; 
expire_date(0) = quadv 
expire_date(1) = quadv 
opn. .status(expire_ dat) = 


goto next_opt; 


a size): 
spécitied ‘ 
en do; 
if wnat > 0 | longval(0) > 65535 


error_code = pli$_invextsiz; 
goto Opt_error; 


fcb => fab$w _deq = 


end; 
else feb- -> fab$Sw_deq = 0; 
goto next_opt; 


word; 
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77 
77 
774 opt(file_id): 
775 Tf s porns 
776 hen do; 
777 fcb => nam$t_dvi = aii 
778 fcb => nam$w_did = 0; 
779 fcb -> nam$w_ =did. - = 0; 
780 fcb => nam$w_did_ 
9) a 8 => fab$l— ~fopttabsv_ nam) = true; 
78 else fcb -> fab$l_fop(fab$v_nam) = false; 
784 goto next_opt; 
785 
786 
787 opt(file_id_to): 
788 Tf Specified 
789 then do; 
790 file_id_to_pt = addrval ( 0); 
791 opn. Statustfileid_ to) = true; 
8 3 t t_opt ~_ 
oto next_opt; 
794 $ . 
795 2 
796 2 opt (file_size): 
797 $ Tf s pecified 
798 then fcb => fab$l_alq = Longval(0); 
799 2 else fcb -> fab$l_alq = 0; 
B00 2 goto next_opt; 
801 2 
80 2 : 
80 2 opt (fixed control size): 
804 2 i tied 
805 ¢ then do; 
806 if feb -> attr(atr_v ~Strean) H 
807 3 {cb => attr(atr_v upgate? | H 
808 3 feb -> fab$b_fac(T 
809 3 Longval(0) <0 | longvatcod > 255 
810 3 then do; 
811 4 error_code = pli$_invfxcsiz; 
aig 4 goto opt_error; 
81 4 end; 
814 fcb -> fab$b_fsz = byte; 
gi? fcb -> fabSb_rfm = fab$c_vfc; 
817 else do; 
818 if fcb => este tate Vv print) 
312 3 then 
20 4 ad -> fabsb.. fez = 
gs! 4 fcb -> fab$ = fa abSc vfc; 
bc¢ ; —. => fabsb~ vane tubhe pin) = true; 
824 else fcb -> fab$b_fsz = 0; 
i: = 
goto next_opt; 
Ag 
828 
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829 opt (fixed control _size_to): 
830 if specified 
831 then do; 
8 ¢ fixed _control_to_pt = addrval(0); 
: opn. status (fixedctl_to) = true: 
end; 

835 goto next_opt; 
He 
83 
838 opt (fixed_length_records): 
839 if specified & bitval(0) 
840 § then do; 
841 if (fcb => attr(atr_v_stream) & 
Hh 3 fcb--> attr(atr_v_output)) | 
84 ; (fcb => fab$b_rf¥m = fab$c_vfc) | 
844 (fcb => fab$b_fac(fab$v_bio)) 
845 3 then do; : 
846 4 error_code = pli$_confixlen; 
847 4 goto opt_error; 
848 4 end; 
849 3 fcb -> fab$Sb_rfm = fab$c_fix; 
850 3 end; 
851 2 goto next_opt; 
S26 2 
85 
854 Rot toreup presset ions 
855 ongtemp = group_prot: 
856 2 goto protection; 
857 2 
858 2 : - 
859 2 opt Cignore_Line_marks) : , . 
860 3 fcb -> attr(atr_v_app_comma) = “(specified & bitval(0)); 
861 goto next_opt; 
£66 2 
86 2 . 
864 2 opt (indexed): 
Be? 2 if specified & bitval(0) 
867 § if fcb -> attr(atr_v_output) & “fcb => attr(atr_v_app) 
868 3 then do; ; 
869 4 error_code = pli$_creindex; 
870 4 goto opt_error; 
871 4 end; 
a7¢ ; fcb -> attr(atr_v_indexed) = true; 

7 fcb -> fab$b_org = fab$c_idx; 
874 3 H 
875 else do; 
876 if fcb -> attrfatr_v_keyed) & 
877 “fcb => fab$b_fac(fab$v_bio) 
378 then fcb -> fab$Sb_org = fab$c_rel; 

79 else fcb -> fab$b_org = fab$c_seq; 
880 end; 
ase goto next_opt; 
884 opt (indexed_fill): rm : 
885 fcb"-> rab$t_rop(rab$v_loa) = specified & bitval(0); 
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886 goto next_opt; 
887 
888 
889 opt (index_number): 
890 if specified 
891 then do; 
89 if longval(0) > 255 
89 then do; 
894 4 error_code = pli$_invindnum; 
895 4 goto opt_error; 
896 4 end; 
897 ; fcb -> rab$Sb_krf = byte; 
898 end; 
899 2 else fcb -> rab$b_krf = 0; 
900 2 goto next_opt; 
901 
3 
90 opt (max_record_number): 
904 § if specified 
905 then fcb -> fab$l_mrn = Longval(0); 
906 2 else fcb -> fab$l_mrn = 0; 
907 r4 goto next_opt; 
908 2 
909 2 
910 2 opt (max_record_size): 
911 2 wordtemp = 0; 
aig 2 oytetene = fcb => fab$b_fsz; 
91 2 if fcb => fab$b_org = fab$c_rel 
914 2 then buflen = 480 - wordtemp; 
915 ¢ else do; 
916 if fcb -> fab$Sb_rfm = fab$c_fix 
917 3 then buflen = 512; 
918 3 else buflen = 510 - wordtemp; 
919 3 end; 
920 2 if specified 
921 ¢ then do; 
356 if longval(0) < 0 ! longval(0) > 32767 
92 3 | (fcb => fab$b_org = fab$c_rel & 
924 3 LongvalT0) > 16383) 
925 3 then do; 
926 4 error_code = pli$_invmaxrec; 
927 4 goto opt_error; 
928 & end; 
3 9 ; fcb => fab$Sw_mrs = word; 
end; 
931 § else fcb -> fab$Sw_mrs = buflen; 
236 buflen = max(buflen,fcb -> fab$w_mrs); 
93 2 gotc next_opt; 
934 
BH 
9 opt (multiblock_count): 
937 if specified 
938 then do; 
939 if longval(0) < 0! longval(0) > 127 
940 then do; 
941 & error_code = pli$_invmltblk; 
942 4 goto opt_error; 
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end; 
fcb -> rabSb_mbc = byte; 


end; 
else fcb -> rab$b_mbc = 0; 
goto next_opt; 


opt (multibuffer_count): 
if specTfied 
then do; 
if longval(0) < 0 { longval(0) > 127 
then do; 
error_code = pli$_invmltbuf; 
goto opt_error; 


end; 
fcb => rab$Sb_mbf = byte; 


end; 
else fcb -> rab$Sb_mbf = 0; 
goto next_opt; 


opt (no_share): > 5 ; 
fcb => fabSb_shr(fab$v_nil) = specified & bitval(0); 
goto next_opt; 


opt (owner_group): 
if specified 
then do; 
if longval(0) < 0 ! Longval(0) > 255 
then do; 


error_code = pli$_invowngrp; 
goto opt_error; 
end; 
own_group = word; 
opn.status(uic) = true; 
end: 
goto next_opt; 


opt (owner _member) : 
if specified 
then do; 
if longval(0) < 0! lLongval(0) > 255 
then do; 


error_code = pli$_invownmem; 

goto opt_error; 

end; 
own_mem = word; 
opn:status(uic) = true; 
end; 


goto next_opt; 


opt (owner_protection): 
Longtemp = owner_prot; 
goto protection; 
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1000 
1001 
1008 opt(printer): 
100 if specified & bitval(0) 
1004 then do; 
1005 if fcb => attr(atr_v_stream) | 
1006 fcB => fabSb_rfm = fabSc_fix | 
1007 fcb -> fab$b_rat(fab$v_cr) | 
1008 fcb => fab$b_fac(fab$v_bio) 
1009 then do; 
1010 4 error_code = pli$_conprtfrm; 
1011 4 goto opt_error; 
1oig 4 end; 
101 ; fcb => fab$b_rat(fab$v prn) = true; 
1913 ; fcb -> fabSb_rfm = fabSc_vfc; 

end; 
1016 else fcb -> fab$Sb_rat(fab$v_cr) = “(fcb => attr(atr_v_print) | 
1017 carriage_specified_false); 
1018 goto next_opt; 
1019 
1020 
1021 § opt (read_ahead): 
1066 ¥cb -> rab$l_rop(rab$v_rah) = true; | 
102 2 if specified 
1024 2 then fcb -> rab$l_rop(rab$v_rah) = bitval(0); 
19¢? 2 goto next_opt; 
1026 § 
1027 | 
1028 2 opt (read check): Hae é 
Oe? 2 Fcb -> fab$l_fop(fab$v_rck) = specified & bitval(0); 
1030 2 goto next_opt; 
1031 2 
1032 2 
1033 2 opt(record_id_access): ; 
1034 2 if specified & bitval(0) & fcb -> fab$b_fac(fab$v_bio) 
1035 ¢ then do; 
1036 error_code = pli$_conblokio; 
1037 3 goto opt_error; | 
1038 3 end; : 
1039 2 fcb => attr(atr_v_recidacc) = specified & bitval(0); 
1040 2 goto next_opt; 
1041 § 
10e§ 
104 Po opt (retreival_pointers): 
1044 if specified 
1045 then do; 
1046 if longval(0) > 127 | Longval(0) < -1 
1047 then do; dese" 
1048 4 error_code = pli$_invrtvptr; 
1049 4 goto opt_error; 
108) 3 if Longval(0) = <1. 

ongva =- 

1036 . then longval(0) = 255; 
105 fcb -> fab$Sb_rtv = byte; 
1054 end; 
1055 else fcb -> fab$Sb_rtv = 0; 
1056 goto next_opt; 
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1057 

10 

105 opt (rewind close): 

1060 fcB => fab$l_fop(fab$v_rwc) = specified & bitval(0); 

1061 goto next_opt; 

1808 

106 

1064 opt (rewind open): 
1065 fcB => fab$l_fop(fab$v_rwo) = specified & bitval(0); | 
1066 goto next_opt; 
1067 
1068 
1069 seteinoraceg ty! tm 
1070 fcb => attr(atr_v_scalvar) = specified & bitval(0); 
1071 goto next_opt; 
1Or4 
107 

1074 opt (shared_read): 
1075 if specified & bitval(0) 
1076 then do; 
1077 if fcb -> fab$Sb_shr(fab$v_nil) 
1078 3 then do; 
1079 4 error code = pli$_noshare; 
1080 4 goto opt_error; 
1081 4 end; 
1086 3 fcb => fab$b_shr(fab$v_get) = true; | 
108 ; fcb => fab$b_shr(fab$v_upi) = true; 
1084 end; 
1085 2 else fcb -> fabSb_shr(fab$v_get) = false; 
1086 2 goto next_opt; 
1087 $ 

1088 | 
1089 opt (shared_write): 

1090 if”specified & bitval(0) | 
1091 then do; 

109@ if feb -> fab$b_shr(fab$v_nil) | 
109 3 then do: 
1094 & error_code = pli$_noshare; 
10954 goto opt_error; | 
1096 4 end; 

1097 3 feb -> fabSb_shr(fab$v_put) = true: | 
1098 fcb -> fabSb_shr(fab$v_get) = true; 
1099 fcb -> fab$b_shr(fab$v_del) = true; 
1109 fcb -> fab$Sb_shr(fab$v_upd) = true; 

1101 fcb -> fab$b_shr(fab$v_upi) = true; 

1108 end; 
11 else do; 
1104 fcb -> fab$b_shr(fab$v_put) = false; 
1105 fcb -> fab$Sb_shr(fab$v_del) = false; 
1106 feb => fab$Sb_shr(fab$v_upd) = false; 
1107 end; 

1108 goto next_opt; 

1109 

1110 

1111 opt (spool): ; é 

16 fcb -> fab$l_fop(fab$v_spl) = specified & bitval(0); 

111 goto next_opt; 


— = - 


! | 
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opt (supersede): 
if specified & bitval(0) 


0; 
if feb => attr(atr_v_app) 
then do; 
error_code = pli$_conappsup; 


end 
fcb -> fab$i_fop(fab$v_mxy) = false; 
‘ fcb => fab$l_fop(fab$v_cif) = false; 
fcb => fab$Sl_fop(fab$v_sup) = true; 
fcb => fab$Sl_fop(fab$v_nef) = true; 
{ aa -> rab$l_rop(rab$v_eof) = false; 
’ end; 
else do; 
if “fcb => attr(atr_v_app) 
then do; 
cb => fab$l_fop(fab$v_mxv) = false; 
fcb => fab$l_fop(fab$v_cif) = false; 
fcb => fab$l_fop(fab$v_sup) = false; 
' fcb => fab$l_fop(fab$v_nef) = false; 
fcb -> rab$l-rop(: »o$v eof) = false; 
end; 
end; | 
| 


goto next_opt; 


opt (system_protection): 
longtemp = system_prot; 
goto protection; 


opt (temporary): 4 
fcb => fab$l_fop(fab$v_tmp) = specified & bitval(0); 
goto next_opt; 


opt (truncate): 
fcb => fab$l_fop(fab$v_tef) = specified & bitval(0); 
goto next_opt; 
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opt (world_protection): 
longtemp = world_prot; 
goto protection; 


opt (write_behind): , x 
fcb => rab$l_rop(rab$v_wbh) = specified & bitval(0); 
goto next_opt; 


o 
i) 


er. 


opt (write_check): } 
fcb => fab$l_fop(fab$v_wek) = specified & bitval(0); 
goto next_opt; 
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if openv -> optbit.env_number = 0 
then openv = addr(end_opt); 

if declared_environment -> optbit.env_number = 0 
then declared_environment = addr(end_opt); 

if openv -> optbit.env_number = 
eclared_environment -> optbit.env_number 

then do; 

call get_opt_val(openv.0); 

call get_opt_val(declared_environment,1); 

C) 


ONAOULWN—O 


nd; 
else do; 
if openv => optbit.env_number < 
declared_environment -> gothit.eau_munber 
then call get_opt_val (openv.0); 
else call get_opt_val(declared_environment,v); 


1173 : /* utility routines */ 

1176 protection: 

1175 if specified 

1378 then 

117 if verify(addrval(0) => stringtemp,'rwedRWED') “= 0 

1178 then do; 

1179 error_code = pli$_invprot; 

1180 goto opt_error; 

1181 end; 

1186 if “specified 

11 then do; 

11 prot(longtemp + no_read) = true; 

1185 prot(longtemp + no_write) = true; 

1186 prot(longtemp + no_execute) = true; 

1187 ; prot(longtemp + no_delete) = trie; 

1188 end; 

1189 else do; 

1190 if Cindex(addrval(0) <-> stringtemp,'r') = 0 & 

11913 index(addrval(0) => stringtemp,'R') = 0) | 

1136 3 then prot(longtemp + no_read) = true; 

119 3 if Cindex(addrval(0) => stringtemp,'w') = 0 & | 

ie 8 6@ index(addrval(0) -> stringtemp,'W') = 0) 

1195 ; then prot(longtemp + no_write) = true; 

1196 if Cindex(addrval(0) => stringtemp,'e') = 0 & 

1197 3 index(addrval(0) => stringtemp,'E') = 0) 

1198 3 then prot(longtemp + no_execute) = true; 

1199 3 if Cindex(addrval(0) => ere, = = 08 

1200 «3 index(addryal(0) -> stringtemp,'D') = 0) 

1201 3 then prot(longtemp + no_deletes = true; 

1308 ; opn.status(protect) = true; 

120 end; 

1204 2 goto next_opt; | 

1205 2 

1206 | 2 /* bottom of loop */ 

1207 

1208 next_opt: 

1209 if specified 

: then do; | 
| 

Big | 
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9 return(1); 
0 yu 
¢ get.op _opt_val: procedure(optpt,valnum); 
H * Parameter declarations */ 
dcl optpt pointer 
5 del valnum fixed bin(7); 
next_specified_env_number = optpt => optbit.env_number; 


f next ~speci tied. énv_number = i next_specifiéd_env _humber = unused_envir_opt 
“next _specified_env_number = unused_envir_opt; 
return; | 
end; 


goto opt_typ(env_type(next_specified_env_number)); 


opt_typ(bitty 
. 4 4 = Heat => B+: hint bitt; 


opt A = hg 2 y tpt 
eptpt : 1°e bity 2s” sz Cod evalct 


SELES 


MIMININ, 


} 
} 
oH, goto on gh exit; 

return; | 
| 


1 
1 
1 
opt -typ(tongtyp? : 
ongval(valnum) = optpt => — ; 
optet = ds ye => > stone 
if ong = Longval (1) 
then goto on _opt_exit, 
return; | 
2 
: 


HOMME BS 
WR O00 NOME WOOO NONE WN Owe 


opt_ sea re ht 9 
(valnum,0) = pew -> address -> qvalue( 
Teadeal Uealinen, 1) = optpt -> ogeress => qvalue( 
getet = addr (optpt -> ge 1 Res » 
a ove 5° 0) ai quadval(1,0) | 
0,1) “= quadvai(1, {)) 
then gots. = roe pate 


o 


09; | 
1) 


ao 


if valnum = 


return; 


opt_typ(stringtyp): 
addrval(valnum) = addr(optpt -> 5 pale 
optpt = addr(optpt -> stringnext(optpt -> aoptstringnext. maxsize)); 
if valnum = 1 & addrval(0) => stringtemp “ 
addrval(1) => stringtemp 
then goto con_opt_exit; 
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return; 

opt_ Syetodert 
78 PF ae 5 = optpt -> +s 
79 at = addr(o +P -> edgong 
80 if valnum = 1 8 addrval(0) ss * deval (1) 
81 then goto con_opt_exit; 
Hy return; 

con_opt_exit 
85 error. code = pli$_conenvopt; 
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} goto opt_error; 
: y ; end get_opt_val; 
1 1 end pliS$Senvir; 
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